home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209b.zip / octave-2.09 / PATOS2.ZIP / updt-octave.cmd < prev   
OS/2 REXX Batch file  |  1997-08-14  |  25KB  |  722 lines
  1. /*
  2. *******************************************************************************
  3. ** Update an previous Octave/2 Installation                                  **
  4. ** (c) Klaus Gebhardt, 1996 - 1997                                           **
  5. *******************************************************************************
  6. */
  7.  
  8. /*
  9. *******************************************************************************
  10. ** This script will make all the necessary changes in the following files:   **
  11. **                                                                           **
  12. **   1. CONFIG.SYS                                                           **
  13. **   2. .emacs                                                               **
  14. **   3. .octaverc                                                            **
  15. **     (or the file pointed to by the environment variable OCTAVE_INITFILE)  **
  16. **   4. %INFOPATH%dir                                                        **
  17. *******************************************************************************
  18. ** It will also copy the info files to the directoy pointed to by the        **
  19. ** variable INFOPATH, and it replaces emx.dll, emxlibcs.dll and              **
  20. ** termcap.dat, if the files coming with Octave/2 are newer than those       **
  21. ** on your system.                                                           **
  22. *******************************************************************************
  23. ** This script also creates a folder with a program object for Octave/2      **
  24. ** on the WPS.                                                               **
  25. *******************************************************************************
  26. ** ALL ORIGINAL FILES, WHICH ARE MODIFIED OR REPLACED BY THIS SCRIPT         **
  27. ** ARE BACKUPED IN THE DIRECTORY YOU HAVE OCTAVE/2 INSTALLED IN.             **
  28. *******************************************************************************
  29. ** NO WARRANTY!                                                              **
  30. *******************************************************************************
  31. */
  32.  
  33. "@echo off"
  34. debug = ">NUL 2>NUL"
  35. debug_mode = 0;
  36.  
  37. version     = "2.09";
  38. script_arc  = "SCRIPTS.ZIP";
  39. dlfcn_arc   = "DLFCN.ZIP";
  40.  
  41. default_dir.0 = 2;
  42. default_dir.1 = "h:/apps/science/octave-";
  43. default_dir.2 = "i:/apps/octave-";
  44.  
  45. config_modified   = 0;
  46. config.0.nr =  9;
  47. config.1.nr =  8; config.1.name = "LIBPATH=";             config.1.zeile = "";
  48. config.2.nr =  9; config.2.name = "SET PATH=";            config.2.zeile = "";
  49. config.3.nr = 16; config.3.name = "SET OCTAVE_HOME=";     config.3.zeile = "";
  50. config.4.nr = 12; config.4.name = "SET TERMCAP=";         config.4.zeile = "";
  51. config.5.nr =  9; config.5.name = "SET TERM=";            config.5.zeile = "";
  52. config.6.nr =  9; config.6.name = "SET HOME=";            config.6.zeile = "";
  53. config.7.nr = 20; config.7.name = "SET OCTAVE_INITFILE="; config.7.zeile = "";
  54. config.8.nr = 13; config.8.name = "SET INFOPATH=";        config.8.zeile = "";
  55. config.9.nr = 12; config.9.name = "SET GNUPLOT=";         config.9.zeile = "";
  56.  
  57. emacs_modified = 0;
  58. octaverc_modified = 0;
  59. dir_modified = 0;
  60.  
  61.  
  62. call RxFuncAdd "SysLoadFuncs", "RexxUtil", "SysLoadFuncs"
  63. call SysLoadFuncs
  64.  
  65. parse upper arg option cmdl
  66.  
  67. /*
  68. *******************************************************************************
  69. ** Debug-Mode                                                                **
  70. *******************************************************************************
  71. */
  72. if (option == "/DEBUG") then
  73.   do
  74.     say "info: Running in DEBUG mode!";
  75.     "@echo on"
  76.     debug = ""
  77.     debug_mode = 1;
  78.   end
  79. else
  80.   do
  81.     debug_mode = 0;
  82.     cmdl = option;
  83.   end
  84.  
  85. /*
  86. *******************************************************************************
  87. ** Wrong argument and usage message                                          **
  88. *******************************************************************************
  89. */
  90. if ((cmdl <> "/USAGE") & (cmdl <> "")) then
  91.   do
  92.     say "error: Unknown command line option!";
  93.     say "";
  94.     cmdl = "/USAGE";
  95.   end
  96.  
  97. if (cmdl == "/USAGE") then
  98.   do
  99.     say "Usage:"
  100.     say "  Type 'updt-octave' to update your Octave/2" version "Installation";
  101.     say "  Type 'updt-octave /usage'   to see this message.";
  102.     say "on FAT systems you must type 'updt-oct' instead of 'updt-octave'";
  103.     exit;
  104.   end
  105.  
  106. /*
  107. *******************************************************************************
  108. ** Updating the installation                                 **
  109. *******************************************************************************
  110. */
  111. say "info: Updating Octave/2" version "..."
  112.  
  113. octave_home = to_unix_sep(directory());
  114. octave_dll = octave_home || "/dll";
  115. if (check_octave_files(octave_home, 1) == 0) then
  116.   do
  117.     say "error: Run this script from within in the directory octave is"
  118.     say "error: installed in!"
  119.     exit;
  120.   end
  121. say "info: Octave/2 is installed in" octave_home || ".";
  122.  
  123. /* Removing old files */
  124. "del doc\refcard*" debug
  125.  
  126. /* Unzip the files for dynamic loading */
  127. call unzip_dlfcn_files dlfcn_arc
  128.  
  129. /* Unzip the script files */
  130. call unzip_script_files script_arc
  131.  
  132. say "info: Done.";
  133. exit;
  134.  
  135. /*
  136. *******************************************************************************
  137. ** This is from inst-octave.cmd                                              **
  138. *******************************************************************************
  139. */
  140.  
  141. /*
  142. *******************************************************************************
  143. ** Write the modified config.sys                                             **
  144. *******************************************************************************
  145. */
  146. write_config_new: procedure expose config. debug version
  147. parse arg boot, dir
  148.   config_old = to_os2_sep(dir) || "\config.old";
  149.   config_new = to_os2_sep(dir) || "\config.new";
  150.   "del" config_new debug
  151.  
  152.   rc = stream(config_old, "C", "open read");
  153.   if rc <> "READY:" then
  154.     do
  155.       say "error: Cannot open the backup of CONFIG.SYS!";
  156.       exit;
  157.     end
  158.  
  159.   rc = stream(config_new, "C", "open write");
  160.   if rc <> "READY:" then
  161.     do
  162.       say "error: Cannot open CONFIG.NEW!";
  163.       rc = stream(config_old, "C", "close");
  164.       exit;
  165.     end
  166.  
  167.   say "info: Writing" config_new "...";
  168.   do while(lines(config_old))
  169.     line = linein(config_old);
  170.     do i=1 to config.0.nr
  171.       if (to_upper(substr(strip(line), 1, config.i.nr)) == config.i.name) then
  172.         do
  173.           if config.i.zeile <> "" then
  174.             do
  175.               p = pos(to_upper(config.i.name), to_upper(config.i.name));
  176.               if (p <= 1) then
  177.                 line = config.i.name || config.i.zeile;
  178.               else
  179.                 line = substr(" ",1,p," ") || config.i.name || config.i.zeile;
  180.               config.i.zeile = "";
  181.             end
  182.           leave;
  183.         end
  184.     end
  185.     call lineout config_new, line
  186.   end
  187.  
  188.   sep = 0;
  189.   do i=1 to config.0.nr
  190.     if (config.i.zeile <> "") then
  191.       do
  192.         if (sep == 0) then
  193.           do
  194.             call lineout config_new, ""
  195.             call lineout config_new, "REM Octave/2" version
  196.             sep = 1;
  197.           end
  198.         call lineout config_new, config.i.name || config.i.zeile;
  199.         config.i.zeile = "";
  200.       end
  201.   end
  202.  
  203.   rc = stream(config_new, "C", "close");
  204.   rc = stream(config_old, "C", "close");
  205.   return;
  206.  
  207. /*
  208. *******************************************************************************
  209. ** Analysing CONFIG.SYS:                                                     **
  210. *******************************************************************************
  211. */
  212. read_config_sys: procedure expose config. default_dir. debug
  213. parse arg boot, dir
  214.   config_old = to_os2_sep(dir) || "\config.old";
  215.   say "info: Copying" boot || "\config.sys to" config_old "...";
  216.   "copy" boot || "\config.sys" config_old debug
  217.  
  218.   rc = stream(config_old, "C", "open read");
  219.   if (rc <> "READY:") then
  220.     do
  221.       say "error: Cannot open the backup of CONFIG.SYS!";
  222.       exit;
  223.     end
  224.  
  225.   say "info: Analysing" config_old "...";
  226.   do while(lines(config_old))
  227.     line  = strip(linein(config_old));
  228.     do i=1 to config.0.nr
  229.       strupper = to_upper(substr(line, 1, config.i.nr));
  230.       if (strupper == config.i.name) then
  231.         do
  232.           config.i.zeile = substr(line, config.i.nr+1);
  233.           leave;
  234.         end
  235.     end
  236.   end
  237.   rc = stream(config_old, "C", "close");
  238.  
  239.   if (config.1.zeile == "") then
  240.     do
  241.       say "error: No "LIBPATH" statement found!";
  242.       exit;
  243.     end
  244.   else libpath = config.1.zeile;
  245.  
  246.   if (config.2.zeile == "") then
  247.     do
  248.       say "error: No "SET PATH" statement found!";
  249.       exit;
  250.     end
  251.   else path = config.2.zeile;
  252.  
  253.   oh = config.3.zeile;
  254.   if (oh <> "") then return to_unix_sep(oh);
  255.   else
  256.     do
  257.       do i = 1 to default_dir.0
  258.         oh = check_octave_old_home(default_dir.i, libpath, path);
  259.         if (oh <> "") then return to_unix_sep(oh);
  260.       end
  261.     end
  262.   return "";
  263.  
  264. check_octave_old_home: procedure expose debug
  265. parse arg str, libpath, path
  266.   string = to_os2_sep(str);
  267.   pa = 0;
  268.   do while(1)
  269.     pa = pos(to_upper(string), to_upper(path), pa + 1);
  270.     if (pa == 0) then return "";
  271.     if (pa <> 1) then
  272.       do
  273.         if (substr(path, pa - 1, 1) <> ";") then iterate;
  274.       end
  275.     pe = pos(";", path, pa);
  276.     if (pe == 0) then old_home = substr(path, pa);
  277.     else              old_home = substr(path, pa, pe-pa);
  278.     qa = pos(to_upper(old_home || "\DLL"), to_upper(libpath));
  279.     if (qa == 0) then iterate;
  280.     if (qa <> 1) then
  281.       do
  282.         if (substr(path, qa - 1, 1) <> ";") then iterate;
  283.       end
  284.     qe = pos(";", libpath, qa);
  285.     if qe == 0 then old_dll = to_upper(substr(libpath, qa));
  286.     else            old_dll = to_upper(substr(libpath, qa, qe-qa));
  287.     if (to_upper(old_home || "\DLL") == old_dll) then
  288.       do
  289.     flag = check_octave_files(old_home, 0);
  290.     if (flag == 0) then
  291.           do
  292.             say "notice: I FOUND AN OLD OCTAVE DIRECTORY ("fullpath") IN";
  293.             say "notice: LIBPATH AND PATH, BUT WITHOUT ANY OCTAVE FILES.";
  294.             say "notice: SHOULD I REMOVE ALL ENTRIES IN LIBPATH AND PATH";
  295.             say "notice: POINTING TO THAT DIRECTORY [Y/N]";
  296.             parse pull in;
  297.             flag = (in == "Y") | (in == "y");
  298.           end
  299.         if (flag) then return to_unix_sep(old_home);
  300.       end
  301.     else  return "";
  302.   end
  303.  
  304. check_octave_files: procedure expose debug
  305. parse arg string, flag
  306.   path = to_os2_sep(string);
  307.   rc = SysFileTree(path || "\octave.exe",     exe, "FO");
  308.   rc = SysFileTree(path || "\octave.ico",     ico, "FO");
  309.   rc = SysFileTree(path || "\dll\cruft?.dll", crt, "FO");
  310.   if (flag <> 0) then rc = SysFileTree(path || "\dll\octave?.dll", oct, "FO");
  311.   else                oct.0 = 2;
  312.   res = (exe.0 == 1) & (ico.0 == 1) & (crt.0 == 4) & (oct.0 == 2);
  313.   return res;
  314.  
  315. /*
  316. *******************************************************************************
  317. ** Updating the emx TERMCAP.DAT                                              **
  318. *******************************************************************************
  319. */
  320. emx_termcap: procedure expose debug
  321. parse arg termcap
  322.   call SysFileTree "etc\termcap.dat", oct_datei, "FT";
  323.   if oct_datei.0 <> 1 then return termcap;
  324.   if datei.1 > 80 then oct = "19" || oct_datei.1;
  325.   else                 oct = "20" || oct_datei.1;
  326.  
  327.   call SysFileTree to_os2_sep(termcap), emx_datei, "FT";
  328.   if emx_datei.0 <> 1 then return "";
  329.   if datei.1 > 80 then emx = "19" || emx_datei.1;
  330.   else                 emx = "20" || emx_datei.1;
  331.  
  332.   if oct == emx then return termcap;
  333.   if oct > emx then
  334.     do
  335.       say "info: Replacing" to_os2_sep(termcap) "...";
  336.       "copy" to_os2_sep(termcap) "termcap.old" debug
  337.       "copy etc\termcap.dat" to_os2_sep(termcap) debug
  338.     end
  339.   else
  340.     do
  341.       say "info: Removing termcap.dat coming with Octave/2 ...";
  342.       "del etc\termcap.dat" debug
  343.       "rd etc" debug
  344.     end
  345.  
  346.   return termcap;
  347.  
  348. /*
  349. *******************************************************************************
  350. ** Replacing the emx-DLLs                                                    **
  351. *******************************************************************************
  352. */
  353. emx_dlls: procedure expose debug
  354. parse arg libpath, file
  355.   call SysFileTree "dll\" || file, oct_datei, "FT";
  356.   if oct_datei.0 <> 1 then return;
  357.   if datei.1 > 80 then oct = "19" || oct_datei.1;
  358.   else                 oct = "20" || oct_datei.1;
  359.  
  360.   count = 0;
  361.   do while(1)
  362.     n = setlocal();
  363.     "SET OCTAVE_LIBPATH=" || libpath
  364.     fullpath = SysSearchPath(OCTAVE_LIBPATH, file);
  365.     if fullpath == "" then leave;
  366.     call SysFileTree fullpath, emx_datei, "FT";
  367.     if emx_datei.0 <> 1 then leave;
  368.     if datei.1 > 80 then emx = "19" || emx_datei.1;
  369.     else                 emx = "20" || emx_datei.1;
  370.     n = endlocal();
  371.  
  372.     if oct == emx then leave;
  373.     if oct > emx then
  374.       do
  375.         count = count+1;
  376.         bak_file = substr(file, 1, length(file)-3) || count;
  377.         "copy" fullpath bak_file debug
  378.         say "info: Older DLL (" || file || ") saved as:" bak_file;
  379.         say "info: Removing DLL (" || file || ") ...";
  380.         rc = 1;
  381.         do while(rc <> 0)
  382.           rc = SysFileDelete(fullpath);
  383.           if rc <> 0 then
  384.             do
  385.               say "notice: UNABLE TO DELETE FILE:" fullpath;
  386.               say "notice: THE DLL IS USED BY ONE OR MORE EMX PROGRAMS!";
  387.               say "notice: KILL ALL THOSE PROGRAMS BEFORE CONTINUING!";
  388.               say "notice: PRESS ENTER, WHEN READY ...";
  389.               parse pull in;
  390.             end
  391.         end            
  392.       end
  393.     else
  394.       do
  395.         say "info: Removing" file "coming with Octave/2 ...";
  396.         "del dll\" || file debug;
  397.         leave;
  398.       end
  399.   end
  400.   return;
  401.  
  402. /*
  403. *******************************************************************************
  404. ** Updating .octaverc                                                        **
  405. *******************************************************************************
  406. */
  407. update_octaverc: procedure expose debug debug_mode version
  408. parse arg home, initfile, old, new
  409.   if (initfile == "") then octrc = ".octaverc";
  410.   else                     octrc = initfile;
  411.  
  412.   octrc_new = "octaverc.new";
  413.   rc = ini_files(home, octrc, "octaverc", old, new);
  414.   if (rc == -1) then
  415.     do
  416.       "del" octrc_new debug
  417.       rc = stream(octrc_new, "C", "open write");
  418.       if (rc == "READY:") then
  419.         do
  420.           call lineout octrc_new, "# Startup file"
  421.           call lineout octrc_new, "# Octave" version "for OS/2"
  422.           call lineout octrc_new, "# (c) 1996 - 1997, Klaus Gebhardt"
  423.           rc = stream(octrc_new, "C", "close");
  424.           rc = 2;
  425.         end
  426.       else
  427.         do
  428.           say "error: Cannot create octaverc.new!";
  429.          exit;
  430.         end
  431.     end
  432.  
  433.   if (rc == 2) then
  434.     do
  435.       "del" to_os2_sep(home) || "\" || octrc debug
  436.       octrc_ini = to_os2_sep(home) || "\octave.ini"
  437.       "copy" octrc_new octrc_ini debug
  438.       "ren" octrc_ini ".octaverc" debug
  439.       rc = stream(octrc_ini, "C", "open read");
  440.       if (rc == "READY:") then
  441.         do
  442.           rc = stream(octrc_new, "C", "close");
  443.           rc = stream(octrc_ini, "C", "open write");
  444.           call lineout octrc_new, ''
  445.           call lineout octrc_new, 'history_file = "octave.hst"'
  446.           rc = stream(octrc_new, "C", "close");
  447.           return "octave.ini";
  448.         end
  449.       return "";
  450.     end
  451.   return initfile;
  452.  
  453. /*
  454. *******************************************************************************
  455. ** Modify the files .emacs, .octaverc                                        **
  456. *******************************************************************************
  457. */
  458. ini_files: procedure expose debug
  459. parse arg home, inifile, newfile, oldpath, newpath
  460.   file = to_os2_sep(home) || "\" || inifile;
  461.   ini_old = newfile || ".old";
  462.   ini_new = newfile || ".new";
  463.   say "info: Copying" file "to" ini_old "...";
  464.   "copy" file ini_old debug
  465.  
  466.   old = to_unix_sep(oldpath);
  467.   new = to_unix_sep(newpath);
  468.  
  469.   rc = stream(ini_old, "C", "open read");
  470.   if (rc <> "READY:") then return -1;
  471.  
  472.   "del" ini_new debug;
  473.   rc = stream(ini_new, "C", "open write");
  474.   if (rc <> "READY:") then
  475.     do
  476.       say "info: Cannot open" ini_new || "!";
  477.       rc = stream(ini_old, "C", "close");
  478.       exit;
  479.     end
  480.  
  481.   if (to_upper(old) == to_upper(new)) then return 0;
  482.  
  483.   rv = 1;
  484.   do while(lines(ini_old))
  485.     line  = linein(ini_old);
  486.     p = pos(to_upper(old), to_upper(line));
  487.     if (p <> 0) then
  488.       do
  489.         rv = 2;
  490.         if (p == 1) then
  491.           do
  492.             line = new || substr(line, 1+length(old));
  493.           end
  494.         else
  495.           do
  496.             line = substr(line, 1, p-1) || new || substr(line, p+length(old));
  497.           end
  498.       end
  499.     call lineout ini_new, line
  500.   end
  501.  
  502.   rc = stream(ini_new, "C", "close");
  503.   rc = stream(ini_old, "C", "close");
  504.   return rv;
  505.  
  506. /*
  507. *******************************************************************************
  508. ** Remove old INFO files, modify all dir files                               **
  509. *******************************************************************************
  510. */
  511. info_path_dir: procedure expose debug
  512. parse arg info_path, octave_home, version
  513.   infopath = to_os2_sep(info_path);
  514.   octaveinfopath = to_os2_sep(octave_home || "/doc");
  515.  
  516.   p = 1;
  517.   q = 1;
  518.   do while (q > 0)
  519.     q = pos(";", infopath, p);
  520.     if (q == 0) then infodir = substr(infopath, p);
  521.     else             infodir = substr(infopath, p, q - p);
  522.     p = q + 1;
  523.  
  524.     if (infodir == ".")  then iterate;
  525.     if (to_upper(infodir) == to_upper(octaveinfopath)) then iterate;
  526.  
  527.     say "info: Removing old info files in" infodir;
  528.     "del" infodir || "\octave" debug
  529.     "del" infodir || "\octave.i0?" debug
  530.     "del" infodir || "\octave.i1?" debug
  531.     "del" infodir || "\liboct" debug
  532.     "del" infodir || "\liboct.i0?" debug
  533.     "del" infodir || "\faq" debug
  534.     "del" infodir || "\oct-faq" debug
  535.  
  536.     file = infodir || "\dir"
  537.     dir_old = "dir" || p || ".old";
  538.     dir_new = "dir" || p || ".new";
  539.     say "info: Copying" file "to" dir_old "...";
  540.     "copy" file dir_old debug
  541.  
  542.     rc = stream(dir_old, "C", "open read");
  543.     if (rc <> "READY:") then return;
  544.  
  545.     "del" dir_new debug;
  546.     rc = stream(dir_new, "C", "open write");
  547.     if (rc <> "READY:") then
  548.       do
  549.         say "error: Cannot open" dir_new || "!";
  550.         rc = stream(dir_old, "C", "close");
  551.         exit;
  552.       end
  553.  
  554.     line = " ";
  555.     do while(lines(dir_old))
  556.       if line == d2c(31) then call lineout dir_new, line
  557.       line  = linein(dir_old);
  558.       parse var line w1 w2 ":" w3 "." w4
  559.       if ((w1 <> "*") | ((to_upper(w3) <> "(FAQ)") & (to_upper(w3) <> "(OCT-FAQ)") & (to_upper(w3) <> "(OCTAVE)") & (to_upper(w3) <> "(LIBOCT)"))) then
  560.         do
  561.           if line <> d2c(31) then call lineout dir_new, line
  562.         end
  563.     end
  564.  
  565.     call lineout dir_new, "* octave:    (octave).      Octave" version || "."
  566.     call lineout dir_new, "* liboctave: (liboct).      Info about liboctave" version || "."
  567.     call lineout dir_new, "* octave-faq:(oct-faq).     FAQs about Octave" version || "."
  568.    call lineout dir_new, d2c(31)
  569.  
  570.     rc = stream(dir_new, "C", "close");
  571.     rc = stream(dir_old, "C", "close");
  572.  
  573.     say "info: Copying" dir_new "to" file "...";
  574.     "copy" dir_new file debug
  575.   end
  576.   return;
  577.  
  578. /*
  579. *******************************************************************************
  580. ** Unzip DLFCN files                                                         **
  581. *******************************************************************************
  582. */
  583. unzip_dlfcn_files: procedure expose debug
  584. parse arg dlfcn
  585.   ".\unzip -o" dlfcn debug
  586.   return;
  587.  
  588. /*
  589. *******************************************************************************
  590. ** Unzip script files                                                        **
  591. *******************************************************************************
  592. */
  593. unzip_script_files: procedure expose debug
  594. parse arg zipfile
  595.   rc = SysFileTree(zipfile, fs, "F");
  596.   if fs.0 = 0 then return;
  597.   rc = SysFileTree("ChangeLog", fs, "F");
  598.   if fs.0 = 1 then scr = "scripts/*";
  599.   else             scr = "scripts.fat/*";
  600.   say "info: Unzipping scriptfiles ...";
  601.   if fs.0 = 0 then "ren scripts scripts.fat";
  602.   ".\unzip -o" zipfile scr debug
  603.   if fs.0 = 0 then "ren scripts.fat scripts";
  604.   return;
  605.  
  606. /*
  607. *******************************************************************************
  608. ** Create a WPS object for Octave/2                                          **
  609. *******************************************************************************
  610. */
  611. create_wps_object: procedure expose debug
  612. parse arg octave_home, version
  613.  
  614.   octave_folder_id = "<HWB_OCTAVE_FOLDER>";
  615.  
  616.   call SysCreateObject "WPFolder", "Octave/2", "<WP_DESKTOP>", ,
  617.        "OBJECTID="||octave_folder_id, "fail"
  618.  
  619.   object_name = "Octave" version;
  620.   octave_file = to_os2_sep(octave_home) || "\octave.exe";
  621.   octave_icon = to_os2_sep(octave_home) || "\octave.ico";
  622.  
  623.   rc = SysCreateObject("WPProgram", object_name, octave_folder_id, ,
  624.        "EXENAME="octave_file";PROGTYPE=WINDOWABLEVIO;ICONFILE="octave_icon||,
  625.        ";OBJECTID=<HWB_OCTAVE>", "replace");
  626.  
  627.   if rc == 1 then say "info: Program object for Octave created successfully."
  628.   else            say "notice: Could not create program object for Octave."
  629.  
  630.   call make_book 'oct-faq.inf', 'FAQ about Octave', ''
  631.   call make_book 'octave.inf', 'GNU Octave', ''
  632.   call make_book 'liboct.inf', 'Octave C++ Classes', ''
  633.  
  634.   return;
  635.  
  636. make_book: procedure expose octave_folder_id octave_home
  637. parse arg name, title, parm
  638.  
  639.   file = to_os2_sep(octave_home) || "\doc\" || name;
  640.  
  641.   rc = SysCreateObject('WPProgram', title, octave_folder_id, ,
  642.                       'PROGTYPE=PM;EXENAME=VIEW.EXE;PARAMETERS='||file||parm, ,
  643.                       'replace');
  644.  
  645.   if rc == 1 then say "info: Book object" title "created successfully."
  646.   else            say "notice: Could not create book object" title "."
  647.   return;
  648.  
  649. /*
  650. *******************************************************************************
  651. ** Determine the drive OS/2 is booted from                                   **
  652. *******************************************************************************
  653. */
  654. get_boot_drive: procedure expose debug
  655.   irc = SysIni("BOTH", "FolderWorkareaRunningObjects",,
  656.                "ALL:", "Objects");
  657.   boot1 = left(Objects.1, 2);;
  658.   do i = 2 to Objects.0
  659.     if (to_upper(right(Objects.i, 7)) == "DESKTOP")           then boot1 = left(Objects.i, 2);
  660.     if (to_upper(right(Objects.i,17)) == "ARBEITSOBERFLÄCHE") then boot1 = left(Objects.i, 2);
  661.   end
  662.   boot2 = substr(translate(value("PATH", , "OS2ENVIRONMENT")), pos("\OS2\SYSTEM", translate(value("PATH", , "OS2ENVIRONMENT")))-2, 2);
  663.   rc = SysFileTree(boot1 || "\config.sys", cfg, "FO");
  664.   if ((to_upper(boot1) <> to_upper(boot2)) | (cfg.0 <> 1)) then
  665.     do
  666.       say "error: Unable to determine the boot drive!";
  667.       exit;
  668.     end
  669.   return boot1;
  670.  
  671. /*
  672. *******************************************************************************
  673. ** Replace old pathes                                                        **
  674. *******************************************************************************
  675. */
  676. subst_paths: procedure expose debug
  677. parse arg path_arg, old_path, new_path
  678.   path= to_os2_sep(path_arg);
  679.   old = to_os2_sep(old_path);
  680.   new = to_os2_sep(new_path);
  681.  
  682.   p = 0;
  683.   do while(1)
  684.     p = pos(to_upper(old), to_upper(path), p + 1);
  685.     if (p == 0) then
  686.       do
  687.         if (substr(path, length(path)) == ";") then return path || new || ";";
  688.         else                                        return path || ";" || new;
  689.       end
  690.     if (p <> 1) then
  691.       do
  692.         if (substr(path, p - 1, 1) <> ";") then iterate;
  693.       end
  694.     q = pos(";", path, p);
  695.     if (q == 0) then old_path = substr(path, p);
  696.     else             old_path = substr(path, p, q - p);
  697.     if (to_upper(old_path) <> to_upper(old)) then iterate;
  698.     if (q == 0) then return substr(path, 1, p-1) || new;
  699.     else             return substr(path, 1, p-1) || new || substr(path, q);
  700.   end
  701.  
  702. /*
  703. *******************************************************************************
  704. ** Utilities                                                                 **
  705. *******************************************************************************
  706. */
  707. to_upper: procedure
  708. parse arg string
  709.   return translate(string, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz");
  710.  
  711. to_lower: procedure
  712. parse arg string
  713.   return translate(string, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
  714.  
  715. to_unix_sep: procedure
  716. parse arg string
  717.   return translate(string, "/", "\");
  718.  
  719. to_os2_sep: procedure
  720. parse arg string
  721.   return translate(string, "\", "/");
  722.